home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG Library 8 / PC-SIG Library CD-ROM (8th Edition) (1990-04).iso / 001_100 / disk0090 / indexpc.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1989-01-30  |  5.2 KB  |  197 lines
  1. 100  REM INDEXPC Program
  2. 110  REM Forms the Parent/Child Index
  3. 120  REM Copyright (c) 1982 ... 1989 by: Melvin O. Duke.
  4. 130  OPTION BASE 0
  5. 140  DEFINT A-Z
  6. 600  REM Titles
  7. 610  TITLE$ = "Prepare the Parent/Child Index"
  8. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  9. 700  REM Terminate if not called from the Menu
  10. 710  IF COPY2$ = "Melvin O. Duke" THEN 770
  11. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  12. 730  PRINT "Cannot run the"
  13. 740  PRINT TITLE$
  14. 750  PRINT "Program, unless selected from the MENU"
  15. 760  END
  16. 770  REM OK
  17. 900  REM Dimension Statements
  18. 920  MAX.STACK = 2*INT(SQR(MAX.PER)+1)
  19. 930  IF MAX.STACK < 10 THEN MAX.STACK = 10
  20. 940  DIM STACK(MAX.STACK)
  21. 1000  REM Produce the first screen
  22. 1010  KEY ON : CLS : KEY OFF
  23. 1040  REM Find the title location
  24. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  25. 1080  REM Print the title
  26. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  27. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  28. 1250  REM Print the Copyright
  29. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  30. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  31. 1700  REM Display the Copyright
  32. 1710  '
  33. 1720  LOCATE 25,1
  34. 1730  PRINT DATADISK$;
  35. 1740  K$ = INKEY$ : IF K$ = "" THEN 1740
  36. 1750  KEY ON : CLS : KEY OFF
  37. 2000  REM INDEXPC Program Starts Here
  38. 2010  OPEN CC.PERSFILE$ AS #1 LEN = 256
  39. 2020  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  40. 2030  REM Read all records, and count the parents.
  41. 2040  KEY ON : CLS : KEY OFF
  42. 2050  LOCATE 9,1 : PRINT "Counting the number of Actual Parents";
  43. 2060  FOR I = 1 TO MAX.PER
  44. 2070   GET #1, I
  45. 2080   LOCATE 10,1 : PRINT "Processing Person Record:"; I;
  46. 2090   REM Extract information from the file
  47. 2100   T1! = CVS(F1$) : T1 = T1! 'Child-id
  48. 2110   IF T1 <> I THEN 2160
  49. 2120   T6! = CVS(F6$) : T6 = T6!
  50. 2130   T7! = CVS(F7$) : T7 = T7!
  51. 2140   IF T6 <> 0 AND T7 <> 0 THEN PC.COUNT = PC.COUNT + 2 : GOTO 2160
  52. 2150   IF T6 <> 0  OR T7 <> 0 THEN PC.COUNT = PC.COUNT + 1
  53. 2160  NEXT I
  54. 2170  '
  55. 2180  LOCATE 12,1 : PRINT "Reserving Index Space"
  56. 2190  DIM PA.ID(PC.COUNT+1), CH.ID(PC.COUNT+1), B.DATE!(PC.COUNT+1)
  57. 2200  '
  58. 2210  REM Read all records, and create the index.
  59. 2220  C = 0
  60. 2230  LOCATE 14,1 : PRINT "Forming Parent/Child Index Records";
  61. 2240  FOR I = 1 TO MAX.PER
  62. 2250   GET #1, I
  63. 2260   LOCATE 15,1 : PRINT "Processing Person Record:"; I;
  64. 2270   REM Extract information from the file
  65. 2280   T1! = CVS(F1$) : T1 = T1! 'Child-id
  66. 2290   IF T1! <> I THEN 2620
  67. 2300   T6! = CVS(F6$) : T6 = T6! 'Father-id
  68. 2310   T7! = CVS(F7$) : T7 = T7! 'Mother-id
  69. 2320   T8$ = F8$  'Birthdate as dd mmm yyyy
  70. 2330   IF T8$ = "           " THEN BD! = 0 : GOTO 2500
  71. 2340   REM convert Birthdate
  72. 2350   BD! = VAL(RIGHT$(T8$,4))*10000
  73. 2360   MO$ = MID$(T8$,4,3)
  74. 2370   IF MO$ = "Jan" THEN BD! = BD! +  100 : GOTO 2490
  75. 2380   IF MO$ = "Feb" THEN BD! = BD! +  200 : GOTO 2490
  76. 2390   IF MO$ = "Mar" THEN BD! = BD! +  300 : GOTO 2490
  77. 2400   IF MO$ = "Apr" THEN BD! = BD! +  400 : GOTO 2490
  78. 2410   IF MO$ = "May" THEN BD! = BD! +  500 : GOTO 2490
  79. 2420   IF MO$ = "Jun" THEN BD! = BD! +  600 : GOTO 2490
  80. 2430   IF MO$ = "Jul" THEN BD! = BD! +  700 : GOTO 2490
  81. 2440   IF MO$ = "Aug" THEN BD! = BD! +  800 : GOTO 2490
  82. 2450   IF MO$ = "Sep" THEN BD! = BD! +  900 : GOTO 2490
  83. 2460   IF MO$ = "Oct" THEN BD! = BD! + 1000 : GOTO 2490
  84. 2470   IF MO$ = "Nov" THEN BD! = BD! + 1100 : GOTO 2490
  85. 2480   IF MO$ = "Dec" THEN BD! = BD! + 1200 : GOTO 2490
  86. 2490   BD! = BD! + VAL(LEFT$(T8$,2))
  87. 2500   REM create the father/child index record
  88. 2510   IF T6 = 0 THEN 2560  'skip if zero
  89. 2520   C = C + 1
  90. 2530   CH.ID(C) = T1
  91. 2540   PA.ID(C) = T6
  92. 2550   B.DATE!(C) = BD!
  93. 2560   REM create the mother/child index record
  94. 2570   IF T7 = 0 THEN 2620  'skip if zero
  95. 2580   C = C + 1
  96. 2590   CH.ID(C) = T1
  97. 2600   PA.ID(C) = T7
  98. 2610   B.DATE!(C) = BD!
  99. 2620  NEXT I
  100. 2630  CLOSE #1
  101. 2640  LOCATE 17,1 : PRINT "There are:"; C; "Index Records"
  102. 2650  PRINT "Sort the Index Records into ascending sequence"
  103. 2660  REM ***  QUICKSORT Begins Here ***
  104. 2670  '
  105. 2680  REM Establish Initial Constants
  106. 2690  PA.ID(C+1) = 32766      'Maximum Integer in BASIC
  107. 2700  K1 = 0
  108. 2710  K2 = C
  109. 2720  K3 = 0
  110. 2730  LOCATE 20,1 : PRINT "Stack size:";
  111. 2740  LOCATE 20,15 : PRINT K3;
  112. 2750  '
  113. 2760  REM
  114. 2770  IF K1 >= K2 THEN 3370
  115. 2780  '
  116. 2790  REM
  117. 2800  J = K2 + 1
  118. 2810  I = K1
  119. 2820  K5 = INT((K2-K1)/2) + K1
  120. 2830  K4  = PA.ID(K5)
  121. 2840  XK4! = B.DATE!(K5)
  122. 2850  YK4 = CH.ID(K5)
  123. 2860  PA.ID(K5)  = PA.ID(K1)
  124. 2870  B.DATE!(K5)= B.DATE!(K1)
  125. 2880  CH.ID(K5)  = CH.ID(K1)
  126. 2890  PA.ID(K1)  = K4
  127. 2900  B.DATE!(K1)= XK4!
  128. 2910  CH.ID(K1)  = YK4
  129. 2920  '
  130. 2930  REM Increment I
  131. 2940  I = I + 1
  132. 2950  IF PA.ID(I) < K4 THEN 2930
  133. 2960  IF PA.ID(I) = K4  AND B.DATE!(I) < XK4! THEN 2930
  134. 2970  '
  135. 2980  REM Decrement J
  136. 2990  J = J - 1
  137. 3000  IF PA.ID(J) > K4 THEN 2980
  138. 3010  IF PA.ID(J) = K4 AND B.DATE!(J) > XK4! THEN 2980
  139. 3020  '
  140. 3030  REM Compare I and J
  141. 3040  IF J <= I THEN 3120
  142. 3050  '
  143. 3060  REM Interchange Elements
  144. 3070  SWAP PA.ID(I),   PA.ID(J)
  145. 3080  SWAP B.DATE!(I), B.DATE!(J)
  146. 3090  SWAP CH.ID(I),   CH.ID(J)
  147. 3100  GOTO 2930
  148. 3110  '
  149. 3120  REM Interchange and Test
  150. 3130  PA.ID(K1)  = PA.ID(J)
  151. 3140  B.DATE!(K1)= B.DATE!(J)
  152. 3150  CH.ID(K1)  = CH.ID(J)
  153. 3160  PA.ID(J)   = K4
  154. 3170  B.DATE!(J) = XK4!
  155. 3180  CH.ID(J)   = YK4
  156. 3190  IF J-K1 < K2-J THEN 3270
  157. 3200  '
  158. 3210  REM Change the Stack Array
  159. 3220  STACK(K3+1) = K1
  160. 3230  STACK(K3+2) = J - 1
  161. 3240  K1 = J + 1
  162. 3250  GOTO 3320
  163. 3260  '
  164. 3270  REM Change the Stack Array
  165. 3280  STACK(K3+1) = J + 1
  166. 3290  STACK(K3+2) = K2
  167. 3300  K2 = J - 1
  168. 3310  '
  169. 3320  REM Increment K3 by 2
  170. 3330  K3 = K3 + 2
  171. 3340  LOCATE 20,15 : PRINT K3;
  172. 3350  GOTO 2760
  173. 3360  '
  174. 3370  REM Test for Sort Complete
  175. 3380  IF K3 = 0 THEN 3470
  176. 3390  '
  177. 3400  REM Remove from Stack
  178. 3410  K2 = STACK(K3)
  179. 3420  K1 = STACK(K3-1)
  180. 3430  K3 = K3 - 2
  181. 3440  LOCATE 20,15 : PRINT K3;
  182. 3450  GOTO 2760
  183. 3460  '
  184. 3470  REM Sort is Complete
  185. 3480  '
  186. 3490  REM Write the Parent/Child Index
  187. 3500  LOCATE 22,1 : PRINT "Writing the Parent/Child Index"
  188. 3510  OPEN CC.PCINDEX$ FOR OUTPUT AS #2
  189. 3520  WRITE #2,C
  190. 3530  FOR I = 1 TO C
  191. 3540   WRITE #2, PA.ID(I)
  192. 3550   WRITE #2, CH.ID(I)
  193. 3560  NEXT I
  194. 3570  CLOSE
  195. 3580  PRINT "End of Program"
  196. 3590  RUN CC.MENU$
  197.